home *** CD-ROM | disk | FTP | other *** search
Wrap
(*************************************************** Ant Movie Catalog importation script www.antp.be/software/moviecatalog/ [Infos] Authors=(c) 2004 Goster Title=Megafilm (PL) Description=Movie importation script for http://www.film.sarnet.pl/ info & picture, by Goster Site=http://www.film.sarnet.pl/ Language=PL Version=1.0 Requires=3.5.0 Comments=Movie information & picture importation|14.02.2005 Improvements made by Adma's License=This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. | GetInfo=1 [Options] ***************************************************) program Megafilm; var MovieName: string; Link: string; pozycja, pozycja2, pozycja3: integer; cover, nocover: boolean; function FindLine(Pattern: string; List: TStringList; StartAt: Integer): Integer; var i: Integer; begin result := -1; if StartAt < 0 then StartAt := 0; for i := StartAt to List.Count-1 do if Pos(Pattern, List.GetString(i)) <> 0 then begin result := i; Break; end; end; procedure DecodeHTML(var Value: String); var FullValue, CharCode: String; Counter: Integer; begin if Value <> '' then begin FullValue := ''; Counter := 1; repeat if StrGet(Value, Counter) <> '&' then begin CharCode := copy(Value, Counter, 1); case CharCode of '▒': CharCode := '╣'; '╢': CharCode := '£'; 'í': CharCode := 'Ñ'; '╝': CharCode := 'ƒ'; 'ª': CharCode := 'î'; '¼': CharCode := 'Å'; end; FullValue := FullValue + CharCode; Counter := Counter + 1; end else begin CharCode := copy(Value, Counter, 7); case CharCode of 'ą': FullValue := FullValue + '╣'; 'ć': FullValue := FullValue + 'µ'; 'ę': FullValue := FullValue + 'Ω'; 'ł': FullValue := FullValue + '│'; 'ń': FullValue := FullValue + '±'; 'ó': FullValue := FullValue + '≤'; 'ś': FullValue := FullValue + '£'; 'ź': FullValue := FullValue + 'ƒ'; 'ż': FullValue := FullValue + '┐'; 'Ą': FullValue := FullValue + 'Ñ'; 'Ć': FullValue := FullValue + '╞'; 'Ę': FullValue := FullValue + '╩'; 'Ł': FullValue := FullValue + 'ú'; 'Ń': FullValue := FullValue + '╤'; 'Ó': FullValue := FullValue + '╙'; 'Ś': FullValue := FullValue + 'î'; 'Ź': FullValue := FullValue + 'Å'; 'Ż': FullValue := FullValue + '»'; 'Š': FullValue := FullValue + ' '; 'š': FullValue := FullValue + 'í'; 'Ţ': FullValue := FullValue + 'í'; 'ţ': FullValue := FullValue + 'ú'; 'Ť': FullValue := FullValue + 'ñ'; 'ť': FullValue := FullValue + 'Ñ'; 'Ŧ': FullValue := FullValue + 'î'; 'ŧ': FullValue := FullValue + 'º'; 'Ũ': FullValue := FullValue + '¿'; 'ũ': FullValue := FullValue + '⌐'; 'Ű': FullValue := FullValue + '¬'; 'ű': FullValue := FullValue + '½'; 'Ų': FullValue := FullValue + '¼'; 'ų': FullValue := FullValue + '¡'; 'Ŵ': FullValue := FullValue + '«'; 'ŵ': FullValue := FullValue + '»'; 'Ŷ': FullValue := FullValue + '░'; 'ŷ': FullValue := FullValue + '▒'; 'Ÿ': FullValue := FullValue + '▓'; 'ƀ': FullValue := FullValue + '┤'; 'Ɓ': FullValue := FullValue + '╡'; 'Ƃ': FullValue := FullValue + '╢'; 'ƃ': FullValue := FullValue + '╖'; 'Ƅ': FullValue := FullValue + '╕'; 'ƅ': FullValue := FullValue + '╣'; 'Ɔ': FullValue := FullValue + '║'; 'Ƈ': FullValue := FullValue + '╗'; 'ƈ': FullValue := FullValue + '╝'; 'Ɖ': FullValue := FullValue + '╜'; 'Ɛ': FullValue := FullValue + '╛'; 'Ƒ': FullValue := FullValue + '┐'; 'ƒ': FullValue := FullValue + '└'; 'Ɠ': FullValue := FullValue + '┴'; 'Ɣ': FullValue := FullValue + '┬'; 'ƕ': FullValue := FullValue + '├'; 'Ɩ': FullValue := FullValue + '─'; 'Ɨ': FullValue := FullValue + '┼'; 'Ƙ': FullValue := FullValue + '╞'; 'ƙ': FullValue := FullValue + '╟'; 'Ȁ': FullValue := FullValue + '╚'; 'ȁ': FullValue := FullValue + '╔'; 'Ȃ': FullValue := FullValue + '╩'; 'ȃ': FullValue := FullValue + '╦'; 'Ȅ': FullValue := FullValue + '╠'; 'ȅ': FullValue := FullValue + '═'; 'Ȇ': FullValue := FullValue + '╬'; 'ȇ': FullValue := FullValue + '╧'; 'Ȉ': FullValue := FullValue + '╨'; 'ȉ': FullValue := FullValue + '╤'; 'Ȑ': FullValue := FullValue + '╥'; 'ȑ': FullValue := FullValue + '╙'; 'Ȓ': FullValue := FullValue + '╘'; 'ȓ': FullValue := FullValue + '╒'; 'Ȕ': FullValue := FullValue + '╓'; 'ȕ': FullValue := FullValue + '╫'; 'Ȗ': FullValue := FullValue + '╪'; 'ȗ': FullValue := FullValue + '┘'; 'Ș': FullValue := FullValue + '┌'; 'ș': FullValue := FullValue + '█'; 'Ƞ': FullValue := FullValue + '▄'; 'ȡ': FullValue := FullValue + '▌'; 'Ȣ': FullValue := FullValue + '▐'; 'ȣ': FullValue := FullValue + '▀'; 'Ȥ': FullValue := FullValue + 'α'; 'ȥ': FullValue := FullValue + 'ß'; 'Ȧ': FullValue := FullValue + 'Γ'; 'ȧ': FullValue := FullValue + 'π'; 'Ȩ': FullValue := FullValue + 'Σ'; 'ȩ': FullValue := FullValue + 'σ'; 'Ȱ': FullValue := FullValue + 'µ'; 'ȱ': FullValue := FullValue + 'τ'; 'Ȳ': FullValue := FullValue + 'Φ'; 'ȳ': FullValue := FullValue + 'Θ'; 'ȴ': FullValue := FullValue + 'Ω'; 'ȵ': FullValue := FullValue + 'δ'; 'ȶ': FullValue := FullValue + '∞'; 'ȷ': FullValue := FullValue + 'φ'; 'ȸ': FullValue := FullValue + 'ε'; 'ȹ': FullValue := FullValue + '∩'; 'ɀ': FullValue := FullValue + '≡'; 'Ɂ': FullValue := FullValue + '±'; 'ɂ': FullValue := FullValue + '≥'; 'Ƀ': FullValue := FullValue + '≤'; 'Ʉ': FullValue := FullValue + '⌠'; 'Ʌ': FullValue := FullValue + '⌡'; 'Ɇ': FullValue := FullValue + '÷'; 'ɇ': FullValue := FullValue + '≈'; 'Ɉ': FullValue := FullValue + '°'; 'ɉ': FullValue := FullValue + '∙'; 'ɐ': FullValue := FullValue + '·'; 'ɑ': FullValue := FullValue + '√'; 'ɒ': FullValue := FullValue + 'ⁿ'; 'ɓ': FullValue := FullValue + '²'; 'ɔ': FullValue := FullValue + '■'; 'ɕ': FullValue := FullValue + ' '; '%DF;': FullValue := FullValue + '▀'; '4': FullValue := FullValue + '"'; '–': FullValue := FullValue + '-'; '‘': FullValue := FullValue + '"'; '’': FullValue := FullValue + '"'; '“': FullValue := FullValue + '"'; '”': FullValue := FullValue + '"'; '„': FullValue := FullValue + '"'; else FullValue := FullValue + CharCode; end; Counter := Counter + 7; end; until Counter > Length(Value); HTMLDecode(FullValue); Value := FullValue; end end; procedure AnalyzePage(); var Page: TStringList; pozycja, startPos, endPos: integer; linia, adres, tytul: string; begin Page := TStringList.Create; link := URLEncode('http://www.film.sarnet.pl//?show=szukaj&SID=da2725d4cbff8d2cea3a1d67120aeb5f&word=' + MovieName); Page.Text := GetPage(link); pozycja := FindLine(' 0 znalezionych', Page, 0); if pozycja = -1 then begin pozycja := FindLine('znalezionych', Page, 0); if (pozycja >-1) then begin PickTreeClear; linia := Page.GetString(pozycja); startPos := pos('znalezionych', Linia); delete(linia, 1, startPos + 11); if (pos('[Film]', linia) > 0) then begin while (pos('[Film]', linia) > 0) do begin startPos := pos('[Film]', Linia); delete(linia, 1, startPos + 5); startPos := pos('<a href=', Linia); delete(linia, 1, startPos + 7); endPos := pos('>', Linia); adres := copy(linia, 1, endPos - 1); delete(linia, 1, endPos); adres := 'http://www.film.sarnet.pl/' + adres; endPos := pos('• ', Linia); if endPos = 0 then begin endPos := length(linia); tytul := copy(linia, 1, endPos); end else tytul := copy(linia, 1, endPos - 1); HTMLRemoveTags(tytul); DecodeHTML(tytul); if pos('Newsy', tytul) > 0 then delete(tytul, pos('Newsy', tytul), length(tytul)); if pos('Artyku│y', tytul) > 0 then delete(tytul, pos('Artyku│y', tytul), length(tytul)); if pos('Napisy', tytul) > 0 then delete(tytul, pos('Napisy', tytul), length(tytul)); PickTreeAdd(tytul, adres); end; end else begin DecodeHTML(MovieName); ShowMessage('Nie znaleziono ┐adnego filmu spe│niaj╣cego kryteria: "'+MovieName+'".'); end; end else begin DecodeHTML(MovieName); ShowMessage('Nie znaleziono ┐adnego filmu spe│niaj╣cego kryteria: "'+MovieName+'".'); end; end else begin DecodeHTML(MovieName); ShowMessage('Nie znaleziono ┐adnego filmu spe│niaj╣cego kryteria: "'+MovieName+'".'); end; if PickTreeExec(adres) then begin Page.Text := GetPage(adres); link := adres; AnalyzeMoviePage(page); end; Page.Free; end; procedure AnalyzeMoviePage(Page: TStringList); var Linia, tytul, line, Obsada, OrgLine: string; LineNr, licznik: Integer; StartPos, EndPos, i: Integer; begin if cover = false then begin // Tytu│ polski i oryginalny pozycja := FindLine('Szukaj:', Page, 0); pozycja := pozycja + 1; repeat begin linia := Page.GetString(pozycja); HTMLRemoveTags(linia); DecodeHTML(linia); while ((copy(linia, 1, 1) = ' ') or (copy(linia, 1, 1) = ' ') or (copy(linia, 1, 1) = 'á')) do delete(linia, 1, 1); if (linia = '') then pozycja := pozycja +1; end; until (linia <> ''); startPos := pos('(', linia); endPos := pos(')', linia); if ((startPos = 0) and (endPos = 0)) then begin tytul := copy(linia, 1, length(linia)); while ((copy(tytul, 1, 1) = ' ') or (copy(tytul, 1, 1) = ' ')) do delete(tytul, 1, 1); while ((copy(tytul, length(tytul), 1) = ' ') or (copy(tytul, length(tytul), 1) = ' ') or (copy(tytul, length(tytul), 1) = 'á')) do delete(tytul, length(tytul), 1); setField(fieldTranslatedTitle, tytul); setField(fieldOriginalTitle, tytul); end else begin tytul := copy(linia, 1, startPos - 1); while ((copy(tytul, 1, 1) = ' ') or (copy(tytul, 1, 1) = ' ') or (copy(tytul, 1, 1) = 'á')) do delete(tytul, 1, 1); while ((copy(tytul, length(tytul), 1) = ' ') or (copy(tytul, length(tytul), 1) = ' ') or (copy(tytul, length(tytul), 1) = 'á')) do delete(tytul, length(tytul), 1); setField(fieldTranslatedTitle, tytul); tytul := copy(linia, startPos + 1, endPos - startPos - 1); while ((copy(tytul, 1, 1) = ' ') or (copy(tytul, 1, 1) = ' ') or (copy(tytul, 1, 1) = 'á')) do delete(tytul, 1, 1); while ((copy(tytul, length(tytul), 1) = ' ') or (copy(tytul, length(tytul), 1) = ' ') or (copy(tytul, length(tytul), 1) = 'á')) do delete(tytul, length(tytul), 1); setField(fieldOriginalTitle, tytul); end; // Opis filmu tytul := ''; pozycja := pozycja + 1; repeat begin linia := Page.GetString(pozycja); HTMLRemoveTags(linia); while ((copy(linia, 1, 1) = ' ') or (copy(linia, 1, 1) = ' ') or (copy(linia, 1, 1) = 'á')) do delete(linia, 1, 1); DecodeHTML(linia); if (linia = '') then pozycja := pozycja +1; end; until (linia <> ''); pozycja2 := FindLine('ocena:', Page, 0); repeat begin linia := Page.GetString(pozycja); while ((copy(linia, 1, 1) = ' ') or (copy(linia, 1, 1) = ' ') or (copy(linia , 1, 1) = 'á')) do delete(linia, 1, 1); if (linia = '') then begin pozycja := pozycja + 1; linia := Page.GetString(pozycja); end; pozycja3 := pos('<a href="mailto:', linia); if pozycja3 > 0 then begin pozycja := pozycja2; delete(linia, pozycja3, length(linia)); end; pozycja3 := pos('<strong>', linia); if pozycja3 > 0 then begin pozycja := pozycja2; delete(linia, pozycja3, length(linia)); end; HTMLRemoveTags(linia); DecodeHTML(linia); while ((copy(linia, 1, 1) = ' ') or (copy(linia, 1, 1) = ' ') or (copy(linia, 1, 1) = 'á')) do delete(linia, 1, 1); while ((copy(linia, length(linia), 1) = ' ') or (copy(linia, length(linia), 1) = ' ') or (copy(linia, length(linia), 1) = 'á')) do delete(linia, length(linia), 1); tytul := tytul + linia; pozycja := pozycja + 1; end; until (pozycja >= pozycja2); while ((copy(tytul, 1, 1) = ' ') or (copy(tytul, 1, 1) = ' ') or (copy(tytul, 1, 1) = 'á')) do delete(tytul, 1, 1); while ((copy(tytul, length(tytul), 1) = ' ') or (copy(tytul, length(tytul), 1) = ' ') or (copy(tytul, length(tytul), 1) = 'á')) do delete(tytul, length(tytul), 1); if (tytul <> '') then setField(fieldDescription, tytul); //ocena pozycja := FindLine('ocena:', Page, 0); if pozycja > -1 then begin linia := Page.GetString(pozycja); HTMLRemoveTags(linia); DecodeHTML(linia); startPos := pos('ocena:', linia); tytul := copy(linia, startPos + 6, length(linia) - startPos - 6); endPos := pos('.', tytul); tytul := copy(tytul, 1, endPos - 1); setField(fieldRating, tytul); end; //Re┐yser pozycja := FindLine('Re┐yseria:', Page, 0); if pozycja > -1 then begin linia := Page.GetString(pozycja); HTMLRemoveTags(linia); DecodeHTML(linia); startPos := pos('Re┐yseria:', linia); delete(linia, 1, startPos + 9); tytul := copy(linia, 1, length(linia)); while ((copy(tytul, 1, 1) = ' ') or (copy(tytul, 1, 1) = ' ') or (copy(tytul, 1, 1) = 'á')) do delete(tytul, 1, 1); while ((copy(tytul, length(tytul), 1) = ' ') or (copy(tytul, length(tytul), 1) = ' ') or (copy(tytul, length(tytul), 1) = 'á')) do delete(tytul, length(tytul), 1); setField(fieldDirector, tytul); end; //Producent pozycja := -1; pozycja := FindLine('Producent:', Page, 0); if pozycja = -1 then pozycja := FindLine('Dystrybutor:', Page, 0); if pozycja > -1 then begin linia := Page.GetString(pozycja); HTMLRemoveTags(linia); DecodeHTML(linia); startPos := pos('Producent:', linia); if startPos > 0 then begin delete(linia, 1, startPos + 9); endPos := pos('Scenografia:', linia); if endPos = 0 then endPos := pos('Muzyka:', linia); tytul := copy(linia, 1, endPos - 1); end else begin startPos := pos('Dystrybutor:', linia); delete(linia, 1, startPos + 11); tytul := copy(linia, 1, length(linia)); end; while ((copy(tytul, 1, 1) = ' ') or (copy(tytul, 1, 1) = ' ') or (copy(tytul, 1, 1) = 'á')) do delete(tytul, 1, 1); while ((copy(tytul, length(tytul), 1) = ' ') or (copy(tytul, length(tytul), 1) = ' ') or (copy(tytul, length(tytul), 1) = 'á')) do delete(tytul, length(tytul), 1); setField(fieldProducer, tytul); end; // Rok produkcji pozycja := FindLine('Data produkcji:', Page, 0); if pozycja > -1 then begin linia := Page.GetString(pozycja); HTMLRemoveTags(linia); DecodeHTML(linia); startPos := pos('Data produkcji:', linia); delete(linia, 1, startPos + 14); tytul := copy(linia, 1, length(linia)); if copy(tytul, length(tytul), 1) = ' ' then delete(tytul, length(tytul), 1); if copy(tytul, 1, 1) = ' ' then delete(tytul, 1, 1); setField(fieldYear, tytul); end; // Czas trwania pozycja := FindLine('Czas trwania:', Page, 0); if pozycja > -1 then begin linia := Page.GetString(pozycja); HTMLRemoveTags(linia); DecodeHTML(linia); startPos := pos('Czas trwania:', linia); delete(linia, 1, startPos + 12); endPos := pos('min.', linia); if endPos > 0 then begin tytul := copy(linia, 1, endPos - 1); end else begin endPos := pos('Od lat:', linia); tytul := copy(linia, 1, endPos - 1); end; while ((copy(tytul, 1, 1) = ' ') or (copy(tytul, 1, 1) = ' ') or (copy(tytul, 1, 1) = 'á')) do delete(tytul, 1, 1); while ((copy(tytul, length(tytul), 1) = ' ') or (copy(tytul, length(tytul), 1) = ' ') or (copy(tytul, length(tytul), 1) = 'á')) do delete(tytul, length(tytul), 1); setField(fieldLength, tytul); end; //kraj pozycja := FindLine('Produkcja:', Page, 0); if pozycja > -1 then begin linia := Page.GetString(pozycja); HTMLRemoveTags(linia); DecodeHTML(linia); startPos := pos('Produkcja:', linia); delete(linia, 1, startPos + 9); tytul := copy(linia, 1, length(linia)); if copy(tytul, length(tytul), 1) = ' ' then delete(tytul, length(tytul), 1); if copy(tytul, 1, 1) = ' ' then delete(tytul, 1, 1); setField(fieldCountry, tytul); end; // Gatunek pozycja := FindLine('Gatunek:', Page, 0); if pozycja > -1 then begin linia := Page.GetString(pozycja); HTMLRemoveTags(linia); DecodeHTML(linia); startPos := pos('Gatunek:', linia); delete(linia, 1, startPos + 7); endPos := pos('Dystrybutor:', linia) - 1; if endPos = 0 then endPos := length(linia); tytul := copy(linia, 1, endPos); if copy(tytul, length(tytul), 1) = ' ' then delete(tytul, length(tytul), 1); if copy(tytul, 1, 1) = ' ' then delete(tytul, 1, 1); setField(fieldCategory, tytul); end; //URL setField(fieldURL, link); //Obsada pozycja := FindLine('W rolach g│≤wnych', Page, 0); if pozycja > -1 then begin linia := Page.GetString(pozycja + 1); endPos := pos('REKLAMA', linia) - 1; if endPos < 1 then endPos := length(linia); tytul := copy(linia, 1, endPos); endPos := pos('<td>', tytul); delete(tytul, 1, endPos + 3); tytul := StringReplace(tytul, '</strong>', ''); tytul := StringReplace(tytul, '<br><strong>', ',' + #13#10); HTMLRemoveTags(tytul); DecodeHTML(tytul); while ((copy(tytul, 1, 1) = ' ') or (copy(tytul, 1, 1) = ' ') or (copy(tytul, 1, 1) = 'á')) do delete(tytul, 1, 1); while ((copy(tytul, length(tytul), 1) = ' ') or (copy(tytul, length(tytul), 1) = ' ') or (copy(tytul, length(tytul), 1) = 'á') or (copy(tytul, length(tytul), 1) = ',') or (copy(tytul, length(tytul), 1) = ':')) do delete(tytul, length(tytul), 1); tytul := StringReplace(tytul, ': ,',','); setField(fieldActors, tytul); end; end; //Foto if (nocover = false) then begin pozycja := FindLine('Opcja dostΩpna dla zarejestrownych', Page, 0); if pozycja > -1 then begin linia := Page.GetString(pozycja + 1); startPos := pos('.jpg', linia); delete(linia, startPos + 4, length(linia)); licznik := length(linia); while (copy(linia, licznik, 1) <> ',') do licznik := licznik - 1; startPos := licznik + 2; tytul := copy(linia, startPos, length(linia)); if copy(tytul, length(tytul), 1) = ' ' then delete(tytul, length(tytul), 1); if copy(tytul, 1, 1) = ' ' then delete(tytul, 1, 1); tytul := 'http://www.film.sarnet.pl/' + 'images/film/plakat/' + tytul; tytul := URLEncode(tytul); GetPicture(tytul); end; end; //DisplayResults; end; begin if CheckVersion(3,5,0) then begin MovieName := GetField(fieldTranslatedTitle); if MovieName = '' then MovieName := GetField(fieldOriginalTitle); if Input('Megfilm Import', 'Podaj tytu│ filmu:', MovieName) then begin // Zamiana na ISO-8859-2 MovieName:=StringReplace(MovieName, '╣', chr(177)); MovieName:=StringReplace(MovieName, 'µ', chr(230)); MovieName:=StringReplace(MovieName, 'Ω', chr(234)); MovieName:=StringReplace(MovieName, '│', chr(179)); MovieName:=StringReplace(MovieName, '±', chr(241)); MovieName:=StringReplace(MovieName, '≤', chr(243)); MovieName:=StringReplace(MovieName, '£', chr(182)); MovieName:=StringReplace(MovieName, 'ƒ', chr(188)); MovieName:=StringReplace(MovieName, '┐', chr(191)); MovieName:=StringReplace(MovieName, 'Ñ', chr(161)); MovieName:=StringReplace(MovieName, '╞', chr(198)); MovieName:=StringReplace(MovieName, '╩', chr(202)); MovieName:=StringReplace(MovieName, 'ú', chr(163)); MovieName:=StringReplace(MovieName, '╤', chr(209)); MovieName:=StringReplace(MovieName, '╙', chr(211)); MovieName:=StringReplace(MovieName, 'î', chr(166)); MovieName:=StringReplace(MovieName, 'Å', chr(172)); MovieName:=StringReplace(MovieName, '»', chr(175)); pozycja := pos('/cover/', MovieName); if pozycja > 0 then begin MovieName := StringReplace(MovieName, '/cover/' , ''); cover := true; end else cover := false; pozycja := pos('/nocover/', MovieName); if pozycja > 0 then begin MovieName := StringReplace(MovieName, '/nocover/' , ''); nocover := true; end else nocover := false; while (copy(MovieName, length(MovieName), 1) = ' ') do delete(MovieName, length(MovieName), 1); while (copy(MovieName, 1, 1) = ' ') do delete(MovieName, 1, 1); AnalyzePage(); end; end else ShowMessage('Skrypt wymaga programu Ant Movie Catalog w wersji 3.5.0 lub nowszej'); end.